perm filename FIXLPC.OSA[X,ALS] blob
sn#001169 filedate 1972-07-28 generic text, type T, neo UTF8
00010 BEGIN "FIX"
00020 DEFINE ⊂="COMMENT";⊂ 7/27/72 This is a fast version of LIS.SAI;
00030
00040 REQUIRE "COMSUB.HDR[SYS,ALS]" SOURCE_FILE;
00050 REQUIRE "PRELPC[1,ALS]" LOAD_MODULE;
00065 REQUIRE "LPC2[SYS,ALS]" LOAD_MODULE;
00070 FORTRAN REAL PROCEDURE SQRT(REAL X);
00080 FORTRAN REAL PROCEDURE ALOG10(REAL X);
00090 FORTRAN REAL PROCEDURE COS(REAL X);
00100 FORTRAN REAL PROCEDURE SIN(REAL X);
00110 INTEGER DPPOINT,DPP1,DPP2,DATSHIFT;
00120 EXTERNAL PROCEDURE PREPARE; EXTERNAL FORTRAN PROCEDURE LPC1
00130 (REFERENCE REAL A,B,R0,C;REFERENCE INTEGER N,I,J);
00140 DEFINE BPS="12",DATSIZ="1280",BUFEXS="43",BUFSIZ="1323";
00150 DEFINE BYTE="((ILDB(BPT) LSH 24)%2↑24)";
00160 STRING FILEL,FILI,TFILEI,TFILE,FILEI;
00170 SAFE INTEGER ARRAY DATBUF[0:BUFSIZ];
00180 SAFE INTERNAL INTEGER ARRAY LIST[0:1]; ⊂ Needed but not used;
00190 SAFE INTEGER ARRAY LFILE[0:127],INDATA[0:640];
00200 SAFE INTERNAL REAL ARRAY A,B,C[0:256];
00210 REAL X,SX; SAFE REAL ARRAY WINDOW[0:256];
00220 DEFINE INSIZ="24"; SAFE INTERNAL INTEGER ARRAY INNAM[0:INSIZ];
00230 SAFE INTERNAL INTEGER ARRAY INCNT,INSUB,INDIV,INRAW,INDAT[0:INSIZ];
00240 INTEGER CHAN2,CHAN4,CHAN5,EOF,IEOF,EOFA,BRK,BPT,BPTFST,BPTSAV,
00250 LBPT,SEGCNT,SEGTOT,H,I,J,K,L;
00260 INTERNAL INTEGER M,N,P,RATE,STEPS,INFLAG,FLAG,SEGC,SEGMRK,SEGSAV;
00270 INTERNAL INTEGER INTOT,PONY,HINT,UPCNT,TEACH,I1L,I1H,I2L,I2H,I3L,
00280 I3H,INL,INH,NZRNG, FP1L,FP1H,FP2L,FP2H,ILPB,ILPC,IHPB,IHPC ;
00290 INTERNAL INTEGER NF; ⊂ *** USED IN PREPARE;
00300 INTERNAL INTEGER TFLAG,ZEROF,ZEROC;
00310 INTERNAL REAL R0 ;INTERNAL INTEGER NP,NZ,FP1,FP2,FZ ;
00320 INTERNAL REAL NPA,NZA,FP1A,FP2A,FZA, LPE,HPE,AVE ;
00330 INTERNAL INTEGER ARRAY FF[1:5] ; INTERNAL REAL ARRAY AMP[1:5] ;
00340 LABEL START;
00350 STRING READ1,READ2,PREHINT; INTEGER HINCNT,HCOUNT,HINDEX;
00360 DEFINE CR="'15",LF="'12",TB="'11",CRLF="CR&LF";
00370
00380 UPCNT←3;FILEL←"LIST1";FILEI←"INSERT.DAT[1,THO]";M←8;INFLAG←0;
00390 CHAN2←2; CHAN4←4; CHAN5←5;
00400 IF (TFILEI←STRIN("Data file list("&FILEL&") = "))≠"" THEN FILEL←TFILEI;
00410 CLOSE(CHAN5); OPEN(CHAN5,"DSK",1,2,0,30,BRK,EOFA);
00420 LOOKUP(CHAN5,FILEL,1); EOFA←0;
00430 M←8; N←2↑M; NF←2*N; DEFINE PI="3.141592653";
00440 FOR I←0 STEP 1 UNTIL N DO WINDOW[I]←(1-COS((2*PI*I)/N))/2;
00450 OUTSTR(CRLF&"Shift DATABUF by WORDS = "); DATSHIFT←CVD(INCHWL);
00460 OUTSTR(CRLF);
00470 START: WHILE EOFA=0 DO BEGIN "LISTREAD"
00480 HINDEX←21; HCOUNT←HINCNT←0; FILEI←INPUT(CHAN5,1);
00490 IF EOFA≠0 THEN BEGIN
00500 CLOSE(CHAN5); OPEN(CHAN5,"DSK",1,2,0,30,BRK,EOFA);
00510 LOOKUP(CHAN5,FILEL,1); EOFA←0;
00520 DATSHIFT←DATSHIFT+1;OUTSTR("DATSHIFT set to "&CVS(DATSHIFT)&CRLF);
00530 DONE; END;
00540 CLOSE(CHAN4); OPEN(CHAN4,"DSK",'10,10,0,0,0,EOF);
00550 LOOKUP(CHAN4,FILEI,1); ARRYIN(CHAN4,LFILE[0],'200); ⊂ Input header;
00560 EOF←0; SEGC←0; SEGCNT←0; SEGTOT←(LFILE[0]*6)%N; RATE←LFILE[2];
00570 IF RATE=0 THEN RATE←CVD(STRIN("Sampling rate missing. Rate = "));
00580 OUTSTR("Data file "&FILEI&" with "&CVS(SEGTOT)&" half segs"&CRLF);
00590 CLOSE(CHAN2); OPEN(CHAN2,"DSK",'10,0,10,0,0,0); TFILE←"";
00600 FOR I←0 STEP 1 UNTIL 9 DO BEGIN
00610 TFILEI←FILEI[1 TO 1]; IF TFILEI="." THEN DONE;
00620 TFILE←TFILE&TFILEI; FILEI←FILEI[2 TO 9]; END;
00630 SETFORMAT(1,0); TFILE←TFILE&".L"&CVS(DATSHIFT);
00640 ENTER(CHAN2,TFILE,0); ARRYOUT(CHAN2,LFILE[0],'200); ⊂ Copy header;
00650 FOR I←0 STEP 1 UNTIL 639 DO INDATA[I]←0;
00660 ⊂ THE PARA LIMITS ARE (DOUBLE CHECK) F1=200/800 F2=700/2050
00670 F3=2000/3200 NP=800/1500 NZRNG=NP+/-500 ?
00680 FP1=1800/3200 FP2=3200/5000 LPE=300/450 HPE=2500/3000 ;
00690 ⊂ *** I2H CHANGED FROM 28 TO 26 ESCAPE HI AMP F3 ;
00700 SX←RATE/N; I1L←200./SX ; I1H←800./SX+.5 ; I2L←700./SX;
00710 I2H←2050./SX+.5; I3L←1950./SX; I3H←3250./SX+.5;
00720 INL←800./SX; INH←1500./SX+.5; NZRNG←500./SX+.5;
00730 FP1L←1800./SX; FP1H←3200./SX; FP2L←3200./SX+.5; FP2H←5000./SX+.5;
00740 ILPB←300./SX; ILPC←450./SX; IHPC←2500./SX; IHPB←3000./SX;
00750 BPTFST←POINT(BPS,DATBUF[0],-1);
00760 IF DATSHIFT>0 THEN ARRYIN(CHAN4,DATBUF[0],DATSHIFT);
00770 ARRYIN(CHAN4,DATBUF[0],BUFEXS); SEGMRK←SEGC←K←1;
00780 WHILE EOF=0 DO BEGIN
00790 IF SEGC>SEGTOT THEN DONE; ARRYIN(CHAN4,DATBUF[BUFEXS],DATSIZ);
00800 IF EOF≠0 THEN BEGIN J←EOF LAND '777777;
00810 FOR I←J STEP 1 UNTIL N-1 DO DATBUF[I]←0; END;
00820 K←1; BPT←BPTFST; SEGSAV←SEGC;
00830 WHILE K≤6*DATSIZ%N DO BEGIN
00840 IF (J←SEGMRK-SEGC)>0 THEN BEGIN FOR I←1 STEP 1 UNTIL J DO BEGIN
00850 BPT←BPTSAV+42; L←ILDB(BPT); L←ILDB(BPT); BPTSAV←BPT; END;
00860 K←K+J; SEGC←SEGMRK; END;
00870 IF SEGC>SEGTOT THEN DONE; IF K>6*DATSIZ%N THEN DONE; BPTSAV←BPT;
00880 FOR I←0 STEP 1 UNTIL N-1 DO A[I]←BYTE;
00890 FOR I←0 STEP 1 UNTIL N-2 DO A[I]←(A[I+1]-A[I])*WINDOW[I];
00900 ⊂ LOADS DATA IN A, DIFFERENTIATES AND WINDOWS ;
00910 I←24; J←N%2; LPC1(A[0],B[0],R0,C[0],N,I,J);
00920 PREPARE; I←(SEGC-1)*4; L←0;
00930 FOR P←0 STEP 1 UNTIL 23 DO BEGIN
00940 IF INDAT[P]<0 THEN INDAT[P]←0; IF INDAT[P]>63 THEN INDAT[P]←63;
00950 H←(H LSH 6)+INDAT[P];
00960 IF L<5 THEN L←L+1 ELSE BEGIN INDATA[I]←H; L←0; I←I+1;END;
00970 END; SEGMRK←SEGC+1;
00980 IF SEGMRK>SEGSAV+6*DATSIZ%N THEN DONE; END; ⊂ End of WHILE K≤ ;
00990 SEGC←SEGSAV+6*DATSIZ%N; K←1;
01000 FOR I←0 STEP 1 UNTIL BUFEXS-1 DO DATBUF[I]←DATBUF[I+DATSIZ];
01010 FOR I←BUFEXS STEP 1 UNTIL BUFSIZ-1 DO DATBUF[I]←0; END;
01020 ARRYOUT(CHAN2,INDATA[0],SEGTOT*4); CLOSE(CHAN2);
01030 OUTSTR(TFILE&" has been written."&CRLF);
01040 IF EOFA≠0 THEN DONE; END "LISTREAD"; GO TO START; END "FIX";